perm filename TERMS2.NEW[1,JRA] blob
sn#005802 filedate 1972-09-28 generic text, type T, neo UTF8
(DEFPROP TERMS2
(LAMBDA(Z L N)
(PROG (Z1 T1 T2)
(SETQ T2 (SETQ T1 (LIST NIL)))
A (COND ((NULL L) (RETURN T1))
((VAR (CAR L)) (GO B))
((CONST (CAR L)) (COND ((EQ Z (CAAR L)) (RPLACD T2 (LIST L)) (SETQ T2 (CDR T2)))) (GO B))
((EQ N 1) (GO B)))
(SETQ Z1 (TERMS2 Z (CDAR L) (SUB1 N)))
(COND ((EQ (CAAR L) Z) (RPLACD T2 (LIST L)) (SETQ T2 (CDR T2))))
(COND ((CDR Z1) (RPLACD T2 (CDR Z1)) (SETQ T2 (LAST T2))))
B (SETQ L (CDR L))
(GO A)))
EXPR)